home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / comp0_89.lha / Feel / Boot / Compiler / low-seman.em < prev    next >
Lisp/Scheme  |  1993-02-02  |  2KB  |  70 lines
  1. ;; Eulisp Module
  2. ;; Author: pete broadbery
  3. ;; File: low-seman.em
  4. ;; Date: 28/jul/1991
  5. ;;
  6. ;; Project:
  7. ;; Description: 
  8. ;;  low level semantic properties: 
  9. ;;  accessing, and adding new properties
  10. ;;  should really be done with a web of defstructs,
  11. ;;  parallel to the ab-syntax stuff, but this is easier 
  12. ;;  for the moment.
  13.  
  14. (defmodule low-seman 
  15.   (standard0
  16.    list-fns
  17.    abs-syntx
  18.    )
  19.   ()
  20.   (defun stop (x) nil)
  21.  
  22.   ;; use a table to store properties
  23.   (defstruct semantic-info ()
  24.     ((props initform ()
  25.         accessor semantic-props))
  26.     constructor (make-semantic-info))
  27.  
  28.   (defun semantics-ref (info name)
  29.     (let ((xx (assq name (semantic-props info))))
  30.       (if (null xx) nil
  31.     (cdr xx))))
  32.   
  33.   (deflocal *all-properties* ())
  34.  
  35.   ((setter setter) semantics-ref 
  36.    (lambda (info name val)
  37.      (if (eq info ()) (stop (list info name val)) ())
  38.      ;; assumes I never update values
  39.      ((setter semantic-props) info (cons (cons name val)
  40.                      (semantic-props info)))))
  41.  
  42.   ;;((setter table-ref) (semantic-props info) name val)
  43.  
  44.   (defun make-semantic-ref (name)
  45.     (setq *all-properties* (cons name *all-properties*))
  46.     (let ((fn (lambda (x)
  47.         (semantics-ref (syntactic-properties x) name))))
  48.       ((setter setter) fn 
  49.        (lambda (x y) 
  50.      ((setter semantics-ref) (syntactic-properties x) name y)))
  51.       fn))
  52.  
  53.   ;; loose end
  54.   (defmethod make-syntactic-properties ((x syntax-obj) lst)
  55.     ((setter syntactic-properties) x (make-semantic-info))
  56.     nil)
  57.  
  58.   (defun print-props (obj)
  59.     (print obj)
  60.     (mapcar (lambda (prop)
  61.           (let ((xx (semantics-ref (syntactic-properties obj) prop)))
  62.         (if (null xx) nil
  63.           (format t " ~a: ~a~%" prop xx))))
  64.         *all-properties*))
  65.   
  66.   (export semantics-ref make-semantic-ref print-props)
  67.  
  68.   ;; end module
  69.   )
  70.